;;;; Created on 2008-11-17 17:15:12

(in-package :clone-kb)

(defun messages->kb (messages model)
  (let ((*model* model)
        (*model-id* (model-id model))
        (*model-instance-id* (model-instance-name model)))
    (let ((kb (get-model-instance-kb *model-id* *model-instance-id* #'model->kb-instance nil)))
      (cl-kb:with-kb kb t
                     (dolist (message messages)
                       (message->kb-instance message))))))

(defun message->kb-instance (message)
  (cond
   ((eq (message-type message) 'OFFER)
    (let ((prsi (cl-kb:get-simple-instance (g-instance-msg-id (message-id message))))
          (parties (get-party-simple-instances message)))
      (setf (cl-kb:instance-direct-type prsi) (cl-kb:get-cls (g-model-proposal-id)))
      (setf (cl-kb:frame-own-slot-value prsi '|negotiation|::|neg_msg_sender|) (car parties))
      (setf (cl-kb:frame-own-slot-value prsi '|negotiation|::|neg_proposal_id|) (message-id message))
      (dolist (p (cdr parties))
        (push p (cl-kb:frame-own-slot-values prsi '|negotiation|::|neg_msg_receiver|)))
      (setf (cl-kb:frame-own-slot-value prsi '|negotiation|::|neg_msg_timestamp|)
            (get-time-created message))
      (push prsi (cl-kb:frame-own-slot-values (cl-kb:find-simple-instance (g-instance-process-id))
                                        '|negotiation|::|neg_case_proposal|) )
      (dolist (item (message-items message))
        (let ((issueset-si (cl-kb:mk-simple-instance (g-instance-issueset-id (item-name item) (message-id message)) 
                                                     (cl-kb:find-cls (g-model-issueset-id  (item-name item))))))
          (setf (cl-kb:frame-own-slot-value prsi (cl-kb:find-slot (g-model-issueset-slot-id (item-name item)))) issueset-si)
          (dolist (issue (item-issues item))
            (if (cl-kb:find-cls (g-model-issue-id (item-name item) (issue-name issue)) nil)
                (let ((issue-si (cl-kb:mk-simple-instance (g-instance-issue-id (issue-name issue) (item-name item) (message-id message)) 
                                                          (cl-kb:find-cls (g-model-issue-id (item-name item) (issue-name issue))))))
                  (setf (cl-kb:frame-own-slot-value issueset-si (cl-kb:find-slot (g-model-issue-slot-id (item-name item) (issue-name issue) ))) issue-si)
                  (dolist (attr (issue-attributes issue))
                    (msg-attribute-value->slot-value attr (cl-kb:find-cls (g-model-issue-id (item-name item) (issue-name issue))) issue-si)))))))
     
  ))
    
   ((eq (message-type message) 'ADMISSION-REQUEST)
    )
   ((eq (message-type message) 'ADMISSION-RESPONSE)
    (if (string-equal (message-value message) "ACCEPT")
        (let ((party (car (cdr (get-party-simple-instances message)))))
          (if (not (member party (cl-kb:frame-own-slot-values (cl-kb:find-simple-instance (g-instance-context-id)) 
                                                              '|negotiation|::|neg_case_participant|)))
              (push party
                    (cl-kb:frame-own-slot-values (cl-kb:find-simple-instance (g-instance-context-id)) 
                                                 '|negotiation|::|neg_case_participant|))))))
   ((eq (message-type message) 'OFFER-RESPONSE)
    (let ((prsi (cl-kb:get-simple-instance (format nil "msg ~A" (message-responseto message)))))
      (setf (cl-kb:frame-own-slot-value prsi '|negotiation|::|neg_proposal_response|)
            (if (string-equal (message-value message) "ACCEPT") "accept" "reject"))))
   ((eq (message-type message) 'AGREEMENT)
    (let ((con (cl-kb:find-simple-instance (g-instance-conclusion-id)))
          (win (car (cdr (get-party-simple-instances message))))
          (resp-id (if (typep (message-responseto message) 'message) 
                       (message-id (message-responseto message))
                       (message-responseto message)))
          (prop nil))
      (setf prop (cl-kb:find-simple-instance (g-instance-msg-id resp-id)))
      (setf (cl-kb:frame-own-slot-value con '|negotiation|::|neg_case_winner|) win)
      (setf (cl-kb:frame-own-slot-value con '|negotiation|::|neg_case_agreement|) prop)
      (setf (cl-kb:frame-own-slot-value con '|negotiation|::|neg_case_conclusion_date|) (get-time-created message))))))


(defun get-party-simple-instances (message)
  (let ((res (cons nil nil)))
    (dolist (rec (message-receiver message))
        (push (get-party-simple-instance rec) (cdr res)))
    (setf (car res) (get-party-simple-instance (message-sender message)))
    res))

(defun get-time-created (message)
  (let ((tc (find-if #'(lambda (x) (string-equal (msg-attr-name x) "Time Created")) 
                     (message-attributes message))))
    (if (not (null tc))
        (let ((val (cl-ppcre:register-groups-bind (nil vm vd h m s nil vy) 
                                                  ("(\\w+)\\s+(\\w+)\\s+(\\w+)\\s+([\\w]+):([\\w]+):([\\w]+)\\s+(\\w+)\\s+(\\w+)" (msg-attr-value tc)) 
                                                  (date-instance vd (mount-name->number vm) vy h m s))))
          val))))

(defun party-id->party (id)
  (if (string-equal id "Owner")
      (cl-kb:frame-own-slot-value 
       (cl-kb:find-simple-instance (g-instance-context-id))
       '|negotiation|::|neg_case_owner|)
      (let ((party (cl-kb:find-simple-instance (g-instance-party-id id) nil)))
        (if (null party)
            (progn
              (setf party (cl-kb:mk-simple-instance (g-instance-party-id id) 
                                                    (cl-kb:find-cls "one_party")))
              (setf (cl-kb:frame-own-slot-value party '|onenegotiation|::|one_id|) id)))
        party)))
      

(defun get-party-simple-instance (act)
  (let ((party (party-id->party (actor-id act))))
    party))
          
(defun mount-name->number (name)
  (cond
   ((string-equal name "Jan")
                 "1")
   ((string-equal name "Feb")
                 "2")
   ((string-equal name "Mar")
                 "3")
   ((string-equal name "Apr")
                 "4")
   ((string-equal name "May")
                 "5")
   ((string-equal name "Jun")
                 "6")
   ((string-equal name "Jul")
                 "7")
   ((string-equal name "Aug")
                 "8")
   ((string-equal name "Sep")
                 "9")
   ((string-equal name "Oct")
                 "10")   
   ((string-equal name "Nov")
                 "11")
   ((string-equal name "Dec")
                 "12")))
   
(defun value->kb-value (val type)
  (cond 
   ((string-equal type "Amount")
    (parse-integer val))
   ((string-equal type "Currency")
    val)
   (t 
    val)))


(defun msg-attribute-value->slot-value (attr cls item)
  (let ((attrname (g-model-cls-slot-id (cl-kb:frame-name cls) (msg-attr-name attr) )))
    (let ((at (cl-kb:find-slot attrname nil))
          (typ (msg-attr-type attr))
          (val (msg-attr-value attr))
          (converted-value nil)) 
      (if (and at val (not (string-equal val ""))) 
          (progn   
            (setf converted-value (%attribute-value->slot-value val typ nil nil))
            (setf (cl-kb:frame-own-slot-value item at) converted-value))))))
